home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istpt / ISTPT.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  5.4 KB  |  186 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.4
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.4
  6. C---------------------------------------------------------
  7. C---------------------------------------------------------
  8. C    TOOLPACK/1    Release: 2.4
  9. C---------------------------------------------------------
  10. C---------------------------------------------------------
  11. C    TOOLPACK/1    Release: 2.4
  12. C---------------------------------------------------------
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21. C                                   parameter length
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31. C following are for ZYCSDT (Canonicalise Symbol Data Types)
  32.         PROGRAM ISTPT
  33.  
  34. C ----------------------------------------------------------------------
  35. C
  36. C       I S T P T   -   Toolpack Precision Transformer
  37. C
  38. C       Malcolm Cohen, Numerical Algorithms Group, 1984
  39. C
  40. C       Changes the precision of a Fortran-77 program unit from REAL to
  41. C       DOUBLE PRECISION and vice versa.  This is only the top level;
  42. C       all the work is done in PTLIB.
  43. C
  44. C       Malcolm Cohen, Numerical Algorithms Group, 1985
  45. C       Program ISTPT split into ISTPT and PTLIB.
  46. C
  47. C ----------------------------------------------------------------------
  48.  
  49.         INTEGER TREPTH(81),SYMPTH(81),CMIPTH(81),
  50.      +          TKOPTH(81),CMOPTH(81),CMTPTH(81),JUNK,
  51.      +          OPTSTR(81),IODTRE,IODSYM,IODCMI,IODCMT,IODTKO,
  52.      +          IODCMO,NERROR,NWARN
  53.  
  54.  
  55.         INTEGER OPEN,CREATE,GETARG,ZYINCI,ZTKPTI
  56.         EXTERNAL OPEN,CREATE,ERROR,ZINIT,ZQUIT,ZYINSY,ZYINPT,ZMESS,
  57.      +           GETARG,ZYINCI,ZCHOUT,PUTDEC,PUTC,ZTKPTI,CLOSE
  58.  
  59.  
  60. C Initialise program
  61.  
  62.         NERROR=0
  63.         NWARN=0
  64.         CALL ZINIT
  65.  
  66. C Get parameters
  67.  
  68.         IF (GETARG(1,TREPTH,81).EQ.-100) CALL PTARGS(1,TREPTH)
  69.         IF (GETARG(2,SYMPTH,81).EQ.-100) CALL PTARGS(2,SYMPTH)
  70.         IF (GETARG(3,CMIPTH,81).EQ.-100) CALL PTARGS(3,CMIPTH)
  71.         IF (GETARG(4,CMTPTH,81).EQ.-100) CALL PTARGS(4,CMTPTH)
  72.         IF (GETARG(5,TKOPTH,81).EQ.-100) CALL PTARGS(5,TKOPTH)
  73.         IF (GETARG(6,CMOPTH,81).EQ.-100) CALL PTARGS(6,CMOPTH)
  74.         IF (GETARG(7,OPTSTR,81).EQ.-100) CALL PTARGS(7,OPTSTR)
  75.  
  76. C Open files
  77.  
  78.         IODTRE=OPEN(TREPTH,0)
  79.         IF (IODTRE.EQ.-1) CALL ERROR('Can''t open parse tree')
  80.         IODSYM=OPEN(SYMPTH,0)
  81.         IF (IODSYM.EQ.-1) CALL ERROR('Can''t open symbol table')
  82.         IODCMI=OPEN(CMIPTH,0)
  83.         IF (IODCMI.EQ.-1) CALL ERROR('Can''t open comment index')
  84.         IODCMT=OPEN(CMTPTH,0)
  85.         IF (IODCMT.EQ.-1) CALL ERROR('Can''t open comment file')
  86.         IODTKO=CREATE(TKOPTH,1)
  87.         IF (IODTKO.EQ.-1) CALL ERROR('Can''t create token stream')
  88.         IODCMO=CREATE(CMOPTH,1)
  89.         IF (IODCMO.EQ.-1) CALL ERROR('Can''t create comment stream')
  90.  
  91. C Read input
  92.  
  93.         CALL ZYINPT(IODTRE)
  94.         CALL CLOSE(IODTRE)
  95.         CALL ZYINSY(IODSYM)
  96.         CALL CLOSE(IODSYM)
  97.         IF (ZYINCI(IODCMI).NE.-2) CALL ERROR('ZYINCI failed')
  98.  
  99. C Process input
  100.  
  101.         CALL PT(OPTSTR,IODCMT,ZTKPTI(1,IODTKO,IODCMO),NERROR,NWARN)
  102.  
  103. C Terminate
  104.  
  105.         IF (NERROR+NWARN.EQ.0) THEN
  106.             CALL ZMESS('[ISTPT Normal Termination]',1)
  107.             CALL ZQUIT(-2)
  108.         ELSE IF (NERROR.EQ.0) THEN
  109.             CALL ZCHOUT('[ISTPT Terminated with ',1)
  110.             CALL PUTDEC(NWARN,1)
  111.             CALL ZCHOUT(' war'//'ning',1)
  112.             IF (NWARN.GT.1) CALL PUTC(115)
  113.             CALL ZMESS(']',1)
  114.             CALL ZQUIT(-1002)
  115.         ELSE
  116.             CALL ZCHOUT('[ISTPT Error Termination, ',1)
  117.             CALL PUTDEC(NERROR,1)
  118.             CALL ZCHOUT(' er'//'ror',1)
  119.             IF (NERROR.GT.1) CALL PUTC(115)
  120.             CALL ZMESS(']',1)
  121.             CALL ZQUIT(-1)
  122.         END IF
  123.  
  124.         END
  125. C ----------------------------------------------------------------------
  126. C
  127. C       P T A R G S   -   Get ISTPT command arguments from user
  128. C
  129.  
  130.         SUBROUTINE PTARGS(NUMBER,PATH)
  131.         INTEGER NUMBER,PATH(81)
  132.  
  133.         INTEGER PROMPT(24,7),I
  134.  
  135.         SAVE PROMPT
  136.  
  137.         INTEGER ZGTCMD
  138.         EXTERNAL ZGTCMD,ZPRMPT
  139.  
  140. C "Input parse tree: "
  141. C "Input symbol table: "
  142. C "Input comment index: "
  143. C "Input comment stream: "
  144. C "Output token stream: "
  145. C "Output comment stream: "
  146. C "Options: "
  147.  
  148.         DATA (PROMPT(I,1),I=1,19)/73,110,112,117,116,32,112,
  149.      +97,114,115,101,32,116,114,101,101,58,32,129/,
  150.      +       (PROMPT(I,2),I=1,21)/73,110,112,117,116,32,115,
  151.      +121,109,98,111,108,32,116,97,98,108,101,58,
  152.      +32,129/,
  153.      +       (PROMPT(I,3),I=1,22)/73,110,112,117,116,32,99,
  154.      +111,109,109,101,110,116,32,105,110,100,101,120,
  155.      +58,32,129/,
  156.      +       (PROMPT(I,4),I=1,23)/73,110,112,117,116,32,99,
  157.      +111,109,109,101,110,116,32,115,116,114,101,97,109,
  158.      +58,32,129/,
  159.      +       (PROMPT(I,5),I=1,22)/79,117,116,112,117,116,32,
  160.      +116,111,107,101,110,32,115,116,114,101,97,109,
  161.      +58,32,129/,
  162.      +       (PROMPT(I,6),I=1,24)/79,117,116,112,117,116,32,
  163.      +99,111,109,109,101,110,116,32,115,116,114,101,97,
  164.      +109,58,32,129/,
  165.      +       (PROMPT(I,7),I=1,10)/79,112,116,105,111,110,115,
  166.      +58,32,129/
  167.  
  168.         CALL ZPRMPT(PROMPT(1,NUMBER))
  169.         I=ZGTCMD(PATH,0)
  170.  
  171.         END
  172. C ----------------------------------------------------------------------
  173. C
  174. C       A D D S T R   -   Add string to string table
  175. C
  176.  
  177.         INTEGER FUNCTION ADDSTR(STRING)
  178.         INTEGER STRING(*)
  179.  
  180.         INTEGER ZYASTR
  181.         EXTERNAL ZYASTR
  182.  
  183.         ADDSTR=ZYASTR(STRING)
  184.  
  185.         END
  186.